home *** CD-ROM | disk | FTP | other *** search
/ The Atari Compendium / The Atari Compendium (Toad Computers) (1994).iso / files / prgtools / programm.ing / gfa / gfaexprt.lzh / GFAXPERT.LIB / ARRAYSTR.LST < prev    next >
Encoding:
File List  |  1986-10-19  |  11.5 KB  |  463 lines
  1. ' ********************
  2. ' *** ARRAYSTR.LST ***
  3. ' ********************
  4. ' *** important : element with index 0 is ignored !!
  5. '
  6. DEFWRD "a-z"
  7. '
  8. > PROCEDURE freq.string.array(elem$,VAR proc$(),freq)
  9.   ' *** returns frequency of elem$ in string array
  10.   LOCAL last,n
  11.   last=DIM?(proc$())-1
  12.   freq=0
  13.   FOR n=1 TO last
  14.     IF proc$(n)=elem$
  15.       INC freq
  16.     ENDIF
  17.   NEXT n
  18. RETURN
  19. ' **********
  20. '
  21. > PROCEDURE trim.string.array(VAR proc$())
  22.   ' *** remove spaces from beginning and end of all strings
  23.   LOCAL n
  24.   FOR n=1 TO DIM?(proc$())-1
  25.     proc$(n)=TRIM$(proc$(n))
  26.   NEXT n
  27. RETURN
  28. ' **********
  29. '
  30. > PROCEDURE show.text(title$,VAR proc$())
  31.   ' *** show text in array proc$() on screen (20 lines/screen)
  32.   ' *** ETX (CHR$(3) may be used in array as marker for end of text
  33.   ' *** empty lines at end of text are ignored, unless ETX follows
  34.   ' *** use in High or Medium resolution
  35.   '
  36.   ' *** uses Procedures Message.on, Message.off, Scroll.text.up,Scroll.text.down
  37.   ' *** uses Standard-Globals & Standard-Functions !
  38.   '
  39.   LOCAL line.up$,line.dwn$,page.up$,page.dwn$,first.page$,last.page$
  40.   LOCAL last,command$,n,empty,etx!,total$,in$
  41.   LOCAL screen$,first.line,show!,regel
  42.   last=DIM?(proc$())-1
  43.   line.up$=CHR$(0)+CHR$(72)            ! down arrow
  44.   line.dwn$=CHR$(0)+CHR$(80)           ! up arrow
  45.   page.up$=CHR$(56)                    ! <Shift> up arrow
  46.   page.dwn$=CHR$(50)                   ! <Shift> down arrow
  47.   first.page$=CHR$(0)+CHR$(59)         ! <F1>
  48.   last.page$=CHR$(0)+CHR$(68)          ! <F10>
  49.   command$=esc$+line.up$+line.dwn$+page.up$+page.dwn$+first.page$+last.page$
  50.   FOR n=1 TO last
  51.     IF proc$(n)<>""
  52.       empty=n                          ! possibly blank lines from empty+1
  53.     ENDIF
  54.     etx!=TRUE
  55.     EXIT IF proc$(n)=CHR$(3)           ! ETX (End Of Text) found in array
  56.     etx!=FALSE
  57.   NEXT n
  58.   IF etx!
  59.     last=n-1
  60.   ELSE
  61.     IF empty<last
  62.       last=empty                       ! blank lines from empty+1
  63.     ENDIF
  64.   ENDIF
  65.   '
  66.   CLS
  67.   PRINT @center$(@rev$(" "+title$+" "))
  68.   total$="total : "+STR$(last)+" lines"
  69.   PRINT AT(scrn.col.max-LEN(total$),1);total$;
  70.   PRINT AT(1,1);" line"
  71.   DEFLINE 1,5
  72.   LINE 0,1.5*char.height,scrn.x.max,1.5*char.height
  73.   LINE 0,22.5*char.height,scrn.x.max,22.5*char.height
  74.   DEFLINE 1,1
  75.   PRINT AT(1,24);" ";
  76.   OUT 5,1
  77.   PRINT " = line up";
  78.   PRINT AT(1,25);" ";
  79.   OUT 5,2
  80.   PRINT " = line down";
  81.   PRINT AT(20,24);"<Shift> ";
  82.   OUT 5,1
  83.   PRINT " = page up";
  84.   PRINT AT(20,25);"<Shift> ";
  85.   OUT 5,2
  86.   PRINT " = page down";
  87.   PRINT AT(45,24);"<F1>  = first page";
  88.   PRINT AT(45,25);"<F10) = last page";
  89.   PRINT AT(68,24);"<Esc> = exit";
  90.   '
  91.   SGET screen$
  92.   first.line=1
  93.   show!=TRUE
  94.   DO
  95.     IF show!
  96.       regel=1
  97.       n=first.line
  98.       WHILE regel<=20 AND n<=last
  99.         IF LEN(proc$(n))>80
  100.           PRINT AT(1,2+regel);LEFT$(proc$(n),79);
  101.           OUT 5,3
  102.         ELSE
  103.           PRINT AT(1,2+regel);proc$(n)
  104.         ENDIF
  105.         INC regel
  106.         INC n
  107.       WEND
  108.       DEC n
  109.       PRINT AT(7,1);first.line;" - ";n
  110.     ENDIF
  111.     '
  112.     REPEAT
  113.       in$=INKEY$
  114.     UNTIL INSTR(command$,in$)
  115.     EXIT IF in$=esc$
  116.     '
  117.     IF in$=line.up$
  118.       IF first.line=1
  119.         PRINT bel$;
  120.         @message.on("first line !")
  121.         PAUSE 50
  122.         @message.off
  123.         show!=FALSE
  124.       ELSE
  125.         DEC first.line
  126.         show!=FALSE
  127.         @scroll.text.down(3,21)
  128.         PRINT AT(1,3);STRING$(80," ");
  129.         IF LEN(proc$(first.line))>80
  130.           PRINT AT(1,3);LEFT$(proc$(first.line),79);
  131.           OUT 5,3
  132.         ELSE
  133.           PRINT AT(1,3);proc$(first.line)
  134.         ENDIF
  135.         n=first.line+19
  136.         PRINT AT(7,1);first.line;" - ";n;"     "
  137.       ENDIF
  138.     ENDIF
  139.     '
  140.     IF in$=line.dwn$
  141.       IF n=last OR first.line+20>last
  142.         PRINT bel$;
  143.         @message.on("last line !")
  144.         PAUSE 50
  145.         @message.off
  146.         show!=FALSE
  147.       ELSE
  148.         INC first.line
  149.         show!=FALSE
  150.         @scroll.text.up(4,22)
  151.         n=first.line+19
  152.         PRINT AT(1,22);STRING$(80," ");
  153.         IF LEN(proc$(n))>80
  154.           PRINT AT(1,22);LEFT$(proc$(n),79);
  155.           OUT 5,3
  156.         ELSE
  157.           PRINT AT(1,22);proc$(n)
  158.         ENDIF
  159.         PRINT AT(7,1);first.line;" - ";n;"     "
  160.       ENDIF
  161.     ENDIF
  162.     '
  163.     IF in$=page.up$
  164.       IF first.line=1
  165.         PRINT bel$;
  166.         @message.on("first line !")
  167.         PAUSE 50
  168.         @message.off
  169.         show!=FALSE
  170.       ELSE
  171.         IF first.line>20
  172.           SUB first.line,20
  173.         ELSE
  174.           first.line=1
  175.         ENDIF
  176.         SPUT screen$
  177.         show!=TRUE
  178.       ENDIF
  179.     ENDIF
  180.     '
  181.     IF in$=page.dwn$
  182.       IF n>=last
  183.         PRINT bel$;
  184.         @message.on("last line !")
  185.         PAUSE 50
  186.         @message.off
  187.         show!=FALSE
  188.       ELSE
  189.         IF first.line+20<last
  190.           ADD first.line,20
  191.         ELSE
  192.           first.line=last-19
  193.         ENDIF
  194.         IF first.line<1
  195.           first.line=1
  196.         ENDIF
  197.         SPUT screen$
  198.         show!=TRUE
  199.       ENDIF
  200.     ENDIF
  201.     '
  202.     IF in$=first.page$
  203.       first.line=1
  204.       SPUT screen$
  205.       show!=TRUE
  206.     ENDIF
  207.     IF in$=last.page$
  208.       first.line=last-19
  209.       IF first.line<1
  210.         first.line=1
  211.       ENDIF
  212.       SPUT screen$
  213.       show!=TRUE
  214.     ENDIF
  215.     '
  216.   LOOP
  217. RETURN
  218. ' **********
  219. '
  220. > PROCEDURE show.text.page(VAR proc$())
  221.   ' *** show text in array proc$() on screen (20 lines/screen)
  222.   ' *** ETX (CHR$(3) may be used in array as marker for end of text
  223.   ' *** empty lines at end of text are ignored, unless ETX follows
  224.   ' *** use in High or Medium resolution
  225.   '
  226.   ' *** uses Standard-Globals
  227.   '
  228.   LOCAL last,n,empty,etx!,total$,in$,block,gap,y1,y2,x1,x2,x3
  229.   LOCAL t1$,t2$,t3$,screen$,first.line,show!,regel,x,y,k,key$
  230.   last=DIM?(proc$())-1
  231.   FOR n=1 TO last
  232.     IF proc$(n)<>""
  233.       empty=n                         ! possibly blank lines from empty+1
  234.     ENDIF
  235.     etx!=TRUE
  236.     EXIT IF proc$(n)=CHR$(3)          ! ETX (End Of Text) found in array
  237.     etx!=FALSE
  238.   NEXT n
  239.   IF etx!
  240.     last=n-1
  241.   ELSE
  242.     IF empty<last
  243.       last=empty                      ! blank lines from empty+1
  244.     ENDIF
  245.   ENDIF
  246.   '
  247.   CLS
  248.   DEFLINE 1,5
  249.   LINE 0,22*char.height,scrn.x.max,22*char.height
  250.   DEFLINE 1,1
  251.   DEFFILL ,2,4
  252.   FILL scrn.x.max,scrn.y.max
  253.   DEFFILL ,0
  254.   block=17*8
  255.   gap=(scrn.x.max-3*block)/4
  256.   y1=23*char.height-1
  257.   y2=24*char.height+1
  258.   x1=gap-1
  259.   x2=2*gap+block-3
  260.   x3=3*gap+2*block-1
  261.   PBOX x1,y1,x1+block+1,y2
  262.   PBOX x2,y1,x2+block+1,y2
  263.   PBOX x3,y1,x3+block+1,y2
  264.   GET x1,y1,x1+block+1,y2,t1$
  265.   GET x2,y1,x2+block+1,y2,t2$
  266.   GET x3,y1,x3+block+1,y2,t3$
  267.   PRINT AT(10,24);"  next page    "
  268.   PRINT AT(33,24);" previous page "
  269.   PRINT AT(57,24);"      exit     "
  270.   LOCATE 8,24
  271.   OUT 5,2
  272.   LOCATE 24,24
  273.   OUT 5,2
  274.   LOCATE 32,24
  275.   OUT 5,1
  276.   LOCATE 48,24
  277.   OUT 5,1
  278.   LOCATE 57,24
  279.   OUT 5,27
  280.   LOCATE 72,24
  281.   OUT 5,27
  282.   BOX x1,y1,x1+block+1,y2
  283.   BOX x2,y1,x2+block+1,y2
  284.   BOX x3,y1,x3+block+1,y2
  285.   '
  286.   SGET screen$
  287.   first.line=1
  288.   show!=TRUE
  289.   SHOWM
  290.   REPEAT
  291.   UNTIL INKEY$=""
  292.   DO
  293.     IF show!
  294.       regel=1
  295.       n=first.line
  296.       WHILE regel<=20 AND n<=last
  297.         IF LEN(proc$(n))>80
  298.           PRINT AT(1,1+regel);LEFT$(proc$(n),79);
  299.           OUT 5,3
  300.         ELSE
  301.           PRINT AT(1,1+regel);proc$(n)
  302.         ENDIF
  303.         INC regel
  304.         INC n
  305.       WEND
  306.       DEC n
  307.     ENDIF
  308.     '
  309.     CLR page.dwn!,page.up!,exit!
  310.     REPEAT
  311.       MOUSE x,y,k
  312.       key$=INKEY$
  313.       IF y>23*char.height AND k=1
  314.         IF x>=x1 AND x<=x1+block
  315.           page.dwn!=TRUE
  316.           PUT x1,y1,t1$,10
  317.         ENDIF
  318.         IF x>=x2 AND x<=x2+block
  319.           page.up!=TRUE
  320.           PUT x2,y1,t2$,10
  321.         ENDIF
  322.         IF x>=x3 AND x<=x3+block
  323.           exit!=TRUE
  324.           PUT x3,y1,t3$,10
  325.         ENDIF
  326.       ENDIF
  327.       SELECT ASC(RIGHT$(key$))
  328.       CASE 80
  329.         page.dwn!=TRUE
  330.         PUT x1,y1,t1$,10
  331.       CASE 72
  332.         page.up!=TRUE
  333.         PUT x2,y1,t2$,10
  334.       CASE 27
  335.         exit!=TRUE
  336.         PUT x3,y1,t3$,10
  337.       ENDSELECT
  338.     UNTIL page.dwn! OR page.up! OR exit!
  339.     PAUSE 10
  340.     '
  341.     EXIT IF exit!
  342.     '
  343.     IF page.up!
  344.       IF first.line=1
  345.         PRINT bel$;
  346.         PUT x2,y1,t2$,10
  347.         show!=FALSE
  348.       ELSE
  349.         IF first.line>20
  350.           SUB first.line,20
  351.         ELSE
  352.           first.line=1
  353.         ENDIF
  354.         SPUT screen$
  355.         show!=TRUE
  356.       ENDIF
  357.     ENDIF
  358.     '
  359.     IF page.dwn!
  360.       IF n>=last
  361.         PRINT bel$;
  362.         PUT x1,y1,t1$,10
  363.         show!=FALSE
  364.       ELSE
  365.         IF first.line+20<last
  366.           ADD first.line,20
  367.         ELSE
  368.           first.line=last-19
  369.         ENDIF
  370.         IF first.line<1
  371.           first.line=1
  372.         ENDIF
  373.         SPUT screen$
  374.         show!=TRUE
  375.       ENDIF
  376.     ENDIF
  377.     '
  378.   LOOP
  379.   '
  380. RETURN
  381. ' **********
  382. '
  383. > PROCEDURE initio.text.array
  384.   ' *** fill text-array with DATA-lines
  385.   ' *** end of text indicated with ***
  386.   ' *** use in High or Medium resolution
  387.   ' *** global :  TEXT$()
  388.   LOCAL lines,line$,n
  389.   lines=0
  390.   RESTORE txt.data
  391.   READ line$
  392.   REPEAT
  393.     INC lines
  394.     READ line$
  395.   UNTIL line$="***"
  396.   ERASE text$()
  397.   DIM text$(lines)
  398.   RESTORE txt.data
  399.   FOR n=1 TO lines
  400.     READ text$
  401.     text$(n)=SPACE$(5)+text$           ! left margin of 5 spaces !!
  402.   NEXT n
  403.   '
  404.   ' *** switch editor to Overwrite-mode before entering text
  405.   ' *** 70 characters/line
  406.   txt.data:
  407.   DATA "1234567890123456789012345678901234567890123456789012345678901234567890"
  408.   DATA "                                                                      "
  409.   DATA "                                                                      "
  410.   DATA "                                                                      "
  411.   DATA "                                                                      "
  412.   DATA "                                                                      "
  413.   DATA "                                                                      "
  414.   DATA "                                                                      "
  415.   DATA "                                                                      "
  416.   DATA "                                                                      "
  417.   DATA "                                                                      "
  418.   DATA "1234567890123456789012345678901234567890123456789012345678901234567890"
  419.   DATA ***
  420. RETURN
  421. ' **********
  422. '
  423. > PROCEDURE initio.text.array.low
  424.   ' *** fill text-array with DATA-lines
  425.   ' *** end of text indicated with ***
  426.   ' *** use in Low resolution
  427.   ' *** global :  TEXT$()
  428.   LOCAL lines,line$,n
  429.   lines=0
  430.   RESTORE txt.low.data
  431.   READ line$
  432.   REPEAT
  433.     INC lines
  434.     READ line$
  435.   UNTIL line$="***"
  436.   ERASE text$()
  437.   DIM text$(lines)
  438.   RESTORE txt.data
  439.   FOR n=1 TO lines
  440.     READ text$
  441.     text$(n)=text$
  442.   NEXT n
  443.   '
  444.   ' *** switch editor to Overwrite-mode before entering text
  445.   ' *** 40 characters/line
  446.   txt.low.data:
  447.   DATA "1234567890123456789012345678901234567890"
  448.   DATA "                                        "
  449.   DATA "                                        "
  450.   DATA "                                        "
  451.   DATA "                                        "
  452.   DATA "                                        "
  453.   DATA "                                        "
  454.   DATA "                                        "
  455.   DATA "                                        "
  456.   DATA "                                        "
  457.   DATA "                                        "
  458.   DATA "1234567890123456789012345678901234567890"
  459.   DATA ***
  460. RETURN
  461. ' **********
  462. '
  463.